00100	C  MPRNT.F4********** DRAWS MUSIC ON THE PLOTTER OR XGP **********
00200	C *** READS DATA FROM DSK FOR VARIOUS THINGS.
00300	C*** UNKNOWN, ENDIT, ILLEGL, TOOMCH, PLTCMD, SLUR, NAMEXT
00400	
00500		COMMON /DL/IXRX,SAVER,NAME,EXT /FRMT/F78F(1),FA1(1),FA5(1),ASK
00600		1 /LIMIT/LIMIT,ITEM,L,I,M /DPY/GO,TOP,BOT /FONT/JFONT
00700		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
00800	C					   ↓↓↓↓↓ V IS FOR READIN ONLY
00900	C%%%%%%%%
01000		COMMON /STF/RSTFAC(0/7),RSTJ2 /POSI/STFF(0/7),JJ2,POS
01100		1 /PTR/PWDS(350)
01200		1/PLTR/PLT,RHT,DIS,XDIS
01300		COMMON /XRN/ RN(3000),V(3000) /ALF/INP(72),ML /SSS/SSS(200)
01400		1 /SLR/SLURX(272) 
01500	C ORDER OF COMMON MUST! REMAIN AS IS (FOR DMP MODE READ)
01600	CXXX	COMMON/TTOP/JTOP,JBOT
01700		DIS=1.24 
01800	C 1.24 IS FACTOR FOR 8 1/2 X 11 PAGE.
01900	CXX	JTOP=-9999
02000	CXX	JBOT=9999
02100	C SET VERTICAL LIMITS TO KNOW FINAL SIZE OF IMAGE.
02200	CCC	CALL ERRSET(0)
02300	C AVOID USELESS TYPEOUTS.
02400		CALL MPRFAI
02500		END    
02600	
02700	C***** SOME TYPEOUT AND ACCEPT ROUTINES *******
02800	
02900		SUBROUTINE UNKNWN(JA)
03000		CALL TYPSTR('UNKNOWN CODE =')
03100		CALL TYPINT(JA)
03200		CALL TYPCRL
03300	C TRAP FOR UNKNOWN CODE #S (SUCH AS 99 - FOR "NO KSIG".
03400		END
03500	
03600		SUBROUTINE ENDIT(A,ITMS)
03700		COMMON/TTOP/JTOP,JBOT
03800		COMMON /OUTF/JJ,KOUT,KNT
03900	C FIND REAL VERTICAL SIZE OF IMAGE.
04000		X=(JTOP-JBOT)/200.0
04100		CALL TYPFLT(X)
04200		CALL TYPSTR(' INCHES. ')
04300		X=X*2.54
04400		CALL TYPFLT(X)
04500		CALL TYPSTR(' CM.  ')
04600		CALL TYPINT(ITMS)
04700		CALL TYPSTR(' ITEMS.  FILE=')
04800		CALL TYPWRD(KOUT)
04900		CALL TYPSTR('.PLT   ')
05000		CALL TYPINT(KNT)
05100		CALL TYPSTR(' VECTORS.')
05200		CALL PLOT(0,0,99)
05300	C  THE END OF THE DATA
05400		END
05500	
05600		SUBROUTINE ILLEGL(JA)
05700		CALL TYPSTR('ILLEGAL STAFF# ')
05800		CALL TYPINT(JA)
05900		CALL TYPCRL
06000		END
06100	
06200		SUBROUTINE TOOMCH(K)
06300		CALL TYPSTR('***** TOO MUCH DATA ***** ')
06400		CALL TYPINT(K)
06500		CALL TYPSTR('/3000')
06600		STOP
06700		END
06800	
06900	CCCCCCCCCCCCCCCCCCC  SUBRS.  SLUR, PLTSRT, (LINES, RDRAW),PLTCMD
07000	
07100		SUBROUTINE PLTCMD(NOSET)
07200		COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /OUTF/JJ,KOUT,KNT
07300		DIMENSION NMS(20),RMOV1(20),RMOV2(20)
07400	C**** NO MORE THAN 20 FILES PER PAGE **** (COULD BE INCREASED)
07500		COMMON /DL/RSIZ,SAVER,NAME,EXT /ALF/INP(72),ML
07600		COMMON R2,JE,CENTR,JB,RJQ(20),JQ(20)  /INCR/INCR
07700		EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
07800		1,(R3,RJQ(1)),(I2,INP(2)),(R8,RJQ(6)),(R9,RJQ(7)),(NMS(1),NM1)
07900	C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
08000		DATA FA1(1)/'(A1) '/,F78F(1)/'(78F)'/,EXT/'MS'/,RYY/'Y'/
08100	
08200		IF(I2.NE.'%')GO TO 1
08300		I2=0
08400	C  I2=% FIRST TIME THROUGH  (WAS X, BEFORE 2/78)
08500		RXC=0
08600		RMOV1(1)=RYY
08700		NAME=0
08800	14	KA=0
08900	3	KA=KA+1
09000		IF(MLL.EQ.0)GO TO 15
09100		K=K-2
09200		MLL=MLL-1
09300		IF(MLL.NE.0)GO TO 31
09400		IF(MORE)GO TO 10
09500	C ADD 100 TO RSPC TO READ IN NEW ALPHABETICAL SERIES OF FILES.
09600	15	CALL TYPSTR('TYPE FILE NAME')
09700		CALL TYPINT(KA)
09800		CALL TYPSTR(' ')
09900	C  TYPE FIRST NAME, NUMBER  FOR A SERIES, 2ND NUM FOR FIXED SPACE ".
10000		CALL NAMEXT(K,EXT,MLL,RSPC)
10100		MORE=-1
10200		IF(RSPC.LT.100)GO TO 30
10300		MORE=0
10400		RSPC=RSPC-100.
10500	30	IF(KA.LT.21)GO TO 155
10600		CALL TYPSTR('****ONLY 20 FILES ACCEPTED****')
10700		GO TO 10
10800	155	IF(K.NE.' ')GO TO 51
10900		IF(KA.NE.1)GO TO 10
11000	C  DEFAULT NAME IS 'TMP    1'
11100		K='TMP'
11200		MLL=1
11300	51	IF(K.EQ.'99')GO TO 140
11400		IF(KA.EQ.1)NM1=K
11500	C  99=BACKUP
11600	251	IF(MLL.GE.99)GO TO 151
11700		IF(MLL.EQ.0)GO TO 151
11800		K=K+2*(MLL-1)
11900	C THIS CHANGES GIVEN NAME TO LAST OF SERIES.
12000	C I.E. AAAAA 5  WILL GET AAAAE FIRST AND WORK BACKWARDS.
12100	151	IF(K.NE.'NOSET')GO TO 31
12200		NOSET=-1
12300	C  ACTIVATES ANTI-RESET IN MPRFAI.FAI
12400		GO TO 15
12500	
12600	31	IF(LOOKX(K,EXT))GO TO 56
12700	C JUMP IF FILE FOUND
12800		CALL TYPSTR('FILE NOT FOUND')
12900		CALL TYPCRL
13000		GO TO 15
13100	11	FORMAT(A5,I,F)
13200	56	IF(MLL.LT.99)GO TO 560
13300		MLL=0 
13400	561	K=K+2
13500	C  TYPE 'AAAAA 99'  TO FIND ALL IN 'AAAAx' SERIES AUTOMATICALLY
13600		MLL=MLL+1
13700		IF(LOOKX(K,EXT))GO TO 561
13800	C  KEEPS GOING BACK IF FILES ARE FOUND
13900		K=K-2
14000		CALL TYPSTR('READING FILES --- ')
14100		CALL TYPWRD(NM1)
14200		CALL TYPCHR('.',1)
14300		CALL TYPWRD(EXT)
14400		CALL TYPCHR('THRU  ',6)
14500		CALL TYPWRD(K)
14600		CALL TYPCRL
14700	560	NMS(KA)=K
14800		IF(MLL.EQ.0)GO TO 5
14900		R8=RYY
15000		IF(RSPC.NE.0)R8=RSPC
15100		GO TO 21
15200	5	CALL TYPSTR('MOVE UP AT END? ')
15300		ACCEPT 11,R8
15400		IF(R8.EQ.'99')GO TO 15
15500		CALL LO2UP(R8)
15600		X=R8
15700		IF(R8.NE.RYY)R8=0
15800	C  IRCAM FORTRAN GIVES ERROR IF 'REREAD F78F' HITS AN ALPHA.
15900		IF(X.GT.'Z')REREAD F78F,R8
16000	C211	FORMAT(A1)
16100	C255	ACCEPT 211,R8
16200	C	CALL LO2UP(R8)
16300	C	IF(R8.GT.'Z')REREAD F78F,R8
16400	C	IF(R8.EQ.99.)GO TO 15
16500	C	IF(R8.NE.RYY)R8=0
16600	C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'  ('NO', R8=0, IS DEFAULT ANSWER)
16700	21	RMOV1(KA+1)=R8
16800		RMOV2(KA)=R8
16900		GO TO 3
17000	140	KA=KA-1
17100		GO TO 15
17200	
17300	10	KB=KA-1
17400	22  	CALL TYPSTR('SIZE FACTOR? ')
17500		ACCEPT F78F,RSIZ,R9
17600	
17700	C********  SET R9 TO 1 FOR FULL DENSITY FILLER ON SIZES OVER 1.9
17800	C********   R9=SLICE INCREMENT FOR FILLER
17900	
18000		IF(RSIZ.EQ.99)GO TO 5
18100		IF(RSIZ.EQ.0)RSIZ=1.
18200		CALL TYPSTR('TYPE OUTPUT NAME - ')
18300		ACCEPT 11,JJ
18400		CALL LO2UP(JJ)
18500		IF(JJ.EQ.' ')JJ='PLT'
18600		IF(JJ.EQ.'*')JJ=NMS(KA-1)
18700	C TYPE * TO USE 1ST INPUT NAME FOR OUTPUT NAME.
18800		KOUT=JJ
18900		CALL VARIAN
19000	C THIS SETS UP VARIAN OUTPUT IN MPV.DMP, ELSE A DUMMY
19100		INCR=1
19200	C FOR CALCMP STYLE FILLER TYPE NUM ≥10    (USUALLY 20)
19300	C INCR=20  MEANS FILLER INCREMENT OF 2 ON THE CALCMP
19400		IF(R9.NE.0)INCR=R9
19500	222	KA=0
19600	
19700	1	IF(NAME.NE.0)GO TO 12
19800		IF(KA.NE.KB)GO TO 13
19900		I2=-1
20000		RETURN
20100	C  THE END OF THE DATA
20200	13	NAME=NMS(KA+1)
20300		CALL TYPWRD(NAME)
20400		CALL TYPCHR('.',1)
20500		CALL TYPWRD(EXT)
20600		CALL TYPCRL
20700		RETURN
20800	12	KA=KA+1
20900		NAME=0
21000		R8=0
21100		R2=RSIZ
21200		R3=RSIZ
21300	C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
21400		R7=0
21500		R5=1
21600		R6=1
21700		IF(RMOV2(KA).NE.RYY)R7=RMOV2(KA)
21800		IF(RMOV1(KA).NE.0)R5=0
21900		IF(RMOV2(KA).NE.0)GO TO 77
22000		IF(R7.EQ.0)RETURN
22100	77	R6=0
22200		END
22300	
22400	
22500		SUBROUTINE SLUR
22600		IMPLICIT INTEGER(A-Q,T-Z)
22700		COMMON /ALF/INP,SLURY(72) /SSS/ SSS(200) /SLR/ SLURX(1)  
22800		REAL CENTR
22900		COMMON /PLTR/PLT,RHT,RDIS,XDIS
23000		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,R7,R8,R9,R10,RA,RB,
23100		1 K,KQ,TWICE,RST7,RX,RXX,RTILT,RC,RZ,RW,J3,J4,
23200		1 J5,J6,J7,J8,J9,J10,J11,JQ(7),R,RJ
23300		1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM,L,I,IX /STF/RSTFAC(0/7),RSTJ2
23400	C  DEFAULT VALUE OF SLUR CURVE FACTOR IS 2.8   C	DATA RZZ/2.8/
23500	
23600	2	IF(J8.GE.7)CALL BRKSLR
23700	C J8=7=SLUR WITH VERT. BRKTS.  =8=BRKT ON LEFT ONLY. =9=ON RIGHT ONLY.
23800		J10=1
23900		J4=0
24000		KQ=5 
24100		TWICE=-1
24200	C  -1 FOR DISPLAY, USES ONLY 1/3 OF SEGMENTS
24300		IF(PLT.GE.0)GO TO 21
24400		TWICE=0
24500		KQ=1
24600		RWID=.2
24700		IF(RHT.LT.2)GO TO 21
24800		TWICE=1
24900		RWID=.14
25000	C  IF SIZE IS GT.2 3 SLURS ARE DRAWN
25100		IF(RHT.LT.3)GO TO 21
25200		TWICE=2
25300	C  IF SIZE IS GE.3 4 SLURS ARE DRAWN
25400		RWID=.1
25500	21	RST7=RSTJ2*7.
25600		RQQ=R5-R4
25700		IF(R6.GT.1000)CALL RNOTE(R6)
25800		GO TO (5,6,7),J8+4
25900		GO TO 4
26000	5	R=30
26100	CC5	R=32
26200	C AFTER DOTTED NOTE
26300		GO TO 8
26400	CC6	R=18
26500	6	R=22
26600	C BETWEEN NOTES
26700	8	RX=-0.75
26800	CC8	RX=-1.3
26900		GO TO 9
27000	7	R=7
27100		RX=RSTJ2
27200	9	CALL RJBX(R)
27300		R6=R6+RX
27400	4	RXX=RHORZ(R6)-R3
27500		RTILT=RQQ*RST7
27600	80	RX=SQRT(RXX*RXX+RTILT*RTILT)
27700		IF(J8.NE.-1)GO TO 10
27800		IF(RQQ.GT.8)RQQ=8
27900		IF(RQQ.LT.-8)RQQ=-8
28000	CCCC	RQQ=RQQ*RSTFAC(J2)
28100		IF(R7)RQQ=-RQQ
28200		R3=R3-RQQ*RSTJ2
28300	CCCC	R3=R3-RQQ
28400	C  MOVES STEEP SLUR LEFT OR RIGHT IF P8=-1
28500	10	RJ=ABS(R7)
28600	C R7+100=LEFT HALF SLUR, +200=RIGHT HALF, +300=REVERSE DIRECTION.
28700		IF(RJ.LT.100)RJ=-1
28800		IF(RJ.GE.300)RJ=0
28900		R7=AMOD(R7,100.0)
29000		R=RDIS*RX*.4
29100		L=R
29200		L=L*2
29300	C TO INSURE AN EVEN NUMBER OF VECTORS (ONLY 1/2 ARE COMPUTED IN SLOOP)
29400		IF(L.LT.60)L=60
29500		IF(L.GT.272)L=272
29600		IF(J11.EQ.0)GO TO 1
29700		R=R*2
29800		RZ=L-60
29900		J11=RZ * 10./212. +7.
30000		RXXX=.02
30100	111	IF(R.GT.272)J11=J11-RXXX*(R-272)
30200	 	IF(J11.LT.7)J11=7
30300	11	IF(MOD(L/J11,2).NE.0)GO TO 1
30400	C TO INSURE AN UNEVEN NUMBER OF SEGMENTS (SO THE LAST IS BLACK)
30500		J11=J11+1
30600		GO TO 11
30700	CC	J11=R/7. 
30800	CC	IF(J11.LT.7)J11=7
30900	CC	IF(J11.GT.39)J11=39
31000	CC	J11=RDIS*L/J11
31100	C FOR DASHED SLURS  
31200	C  L=NUMB OF SEGMENTS IN THE CURVE.
31300	
31400	1	R=CENTR
31500		IF(J8.GT.0)GO TO 180
31600	C  JUMP FOR BRACKETS
31700		CALL SLOOP
31800	
31900		IF(J4.NE.0)GO TO 83
32000	87	CALL LINES(SLURX(J10),SLURY(J10),3)
32100		IF(J11.EQ.0)J4=-1
32200	83	J5=KQ
32300		J6=J10
32400		J7=L
32500	CCCC	IF(J11.NE.0)GO TO  122
32600		IF(J4)GO TO 22
32700		IF(J11.NE.0)GO TO 22
32800		J5=-1
32900		J6=L
33000		J7=J10
33100	22	CALL SLRS
33200	CC22	DO 88 K=J6,J7,J5
33300	CC88	CALL LINES(SLURX(K),SLURY(K),2)
33400	CC	GO TO 123
33500	
33600	CC122	KD=2
33700	CC	KT=0
33800	CC	KA=1
33900	C THIS WILL MAKE DASHED SLURS  J11 HAS DASH SIZE.
34000	CC	DO 188 K=J6,J7,J5
34100	CC	KT=KT+1
34200	CC	IF(KT.LT.J11)GO TO 188
34300	CC	KT=0
34400	CC	KD=KD+KA
34500	CC	KA=-KA
34600	C  BLANK-DASH FLIP-FLOP
34700	CC188	CALL LINES(SLURX(K),SLURY(K),KD)
34800	
34900	123	IF(J5.GT.1)CALL LINES(SLURX(L),SLURY(L),2)
35000		IF(TWICE)RETURN
35100		TWICE=TWICE-1
35200		IF(J8.GT.0)GO TO 182
35300		J4=-J4
35400		R7=R7+RWID
35500	C  RWID=WIDTH OF SLUR -- SEE DATA
35600		GO TO 1
35700	180	RW=R+R7*RST7
35800		TWICE=-1
35900		KQ=1
36000		RX=RX+R3
36100	CC	RA=(R5-R4)*RST7
36200		IF(J9.EQ.0)GO TO 181
36300		TWICE=2
36400		RZ=RTILT/(RX-R3)
36500		RXX=RX
36600		RWID=(R3+RXX)/2.
36700	182	IF(TWICE.EQ.1)GO TO 183
36800	C  DOES LEFT SIDE FIRST.
36900		IF(TWICE.EQ.0)GO TO 184
37000	C LAST IS NUMBER.
37100		J8=2
37200		RC=RSTJ2*13.
37300		RX=RWID-RC
37400		RWW=RTILT
37500	185	RTILT=RZ*(RX-R3)
37600	
37700	C  PUT IN FUNC. HERE FOR THIS SLOPE AND FOR PART. BEAMS.
37800	
37900		GO TO 181
38000	183	J8=3
38100		RX=RXX
38200		RTILT=RWW
38300		RXX=R3
38400		R3=RWID+RC
38500		RXX=RZ*(R3-RXX)
38600		R=R+RXX
38700		RW=RW+RXX
38800		GO TO 185
38900	
39000	181	SLURX(1)=R3
39100		SLURY(1)=R
39200		SLURX(2)=R3
39300		SLURY(2)=RW
39400		SLURX(3)=RX
39500		SLURY(3)=RW+RTILT
39600		SLURX(4)=RX
39700		SLURY(4)=R+RTILT
39800		L=4
39900		IF(J8.EQ.2)L=3
40000		IF(J8.EQ.3)J10=2
40100		IF(R10.EQ.0)GO TO 87
40200	C 1ST AND 2ND ENDING BRACKET.  P10=1 OR 2. YOU MUST SET OTHER PARAM.
40300	C  ST P7=8  P8=1.  FOR 2ND ENDING USE P8=2
40400		R4=R4+R7-4.5
40500		R5=1. 
40600		RX=18.
40700		J3=R3+RX*RSTJ2
40800		R6=50003899.+R10*10000.
40820		RQQ=R
40840		RWW=RW
40860	C R AND RW WIPED OUT IN ALPHA
40900	1181	CALL ALPHA
40910	C BE CAREFUL ABOUT ALPH MIGHT WIPE OUT!!
41000		J5=1
41010	1184	SLURY(1)=RQQ
41020	C DO THESE HERE BECAUSE THEY GET WIPED OUT IN ALPHA.
41030		SLURY(2)=RWW
41040		SLURY(3)=RWW
41050		SLURY(4)=RQQ
41100		GO TO 87
41200	184	J3=RWID
41300	C  PUT IN VERT. POS. WHEN SLOPE!
41400		R4=RQQ/2.+R4+R7-1.
41500		R6=0.875
41600	C .875 IS SIZE OF NUM.   R7=1 MAKES ITALIC FONT
41700		R7=1.
41800		R8=0
41900		CALL MAKNUM(R9)
42000		END
42100	C  8, POS1, STF, NT1, NT2, POS2, DIP(ABS. UNITS), P8
42200	C        FOR P8: 0= SLUR, 1=BRACKETS, 2=LFT ONLY, 3=RT ONLY
42300	
42400		SUBROUTINE NAMEXT(NAME,EXT,NUM,SPC)
42500		DIMENSION FORM2(5),FORMT(5),NUMS(30)
42600		EQUIVALENCE (F1,FORMT(1)),(F2,FORMT(2)),(F3,FORMT(3)),
42700		1 (F4,FORMT(4)),(F5,FORMT(5))
42800		COMMON /ALF/INP(72)
42900		DATA FORMT(1)/'('/,FORM2/'A1,','A2,','A3,','A4,','A5,'/
43000		1, FORM3/'I,F)'/
43100	1	FORMAT(72A1)
43200		ACCEPT 1,INP
43300		DO 2 K=2,72
43400		IF(INP(K).EQ.' ')GO TO 3
43500	2	IF(INP(K).EQ.'.')GO TO 4
43600	3	F3=FORM3
43700		F4=' '
43800		F5=' '
43900	5	F2=FORM2(K-1)
44000		REREAD FORMT,NAME,NUM,SPC
44100		GO TO 10
44200	4	FORMT(3)=FORM2(1)
44300	C  CATCHES DOT
44400		DO 7 N=K+1,72
44500	7	IF(INP(N).EQ.' ')GO TO 8
44600	8	F4=FORM2(N-K-1)
44700		F5=FORM3
44800		F2=FORM2(K-1)
44900		REREAD FORMT,NAME,K,EXT,NUM,SPC
45000		CALL LO2UP(EXT)
45100	10	CALL LO2UP(NAME)
45200		END